home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
dbms_mag
/
9108
/
ehrmann.sep
< prev
next >
Wrap
Text File
|
1991-07-26
|
9KB
|
269 lines
Listing 1: A test script for WAIT.
edit "CUSTOMER"
pickform "1"
while (true)
wait table
prompt "You can make changes - press Esc to exit"
until "Esc"
Do_It! ; save
clearimage ; remove image
quit ; finish script
endwhile
Listing 2: Custom FieldView example
proc FIELD_VIEW()
private HOLDING ; starting value of field
HOLDING = [] ; save field contents
while (true)
fieldview ; enter special mode
wait field ; cannot leave field
prompt "Now in FieldView. Enter/F2 saves; Esc cancels"
until "Enter", "F2", "Esc", "DOS", "DOSBig"
switch
case retval = "Enter" or retval = "F2" :
quitloop
case retval = "Esc" :
[] = HOLDING ; restore field contents
quitloop
otherwise :
beep
endswitch
endwhile
endproc
edit "CUSTOMER"
pickform "1"
while (true)
wait table
prompt "You can make changes - press Esc to exit",
"Press Alt-F5 or Ctrl-F to enter FieldView"
until "Esc", "FieldView", "F35"
switch
case retval = "FieldView" or retval = "F35" :
FIELD_VIEW() ; jump to special proc
case retval = "Esc" :
Do_It! ; save
clearimage ; remove image
quit ; finish script
endswitch
endwhile
Listing 3: Alternate FieldView
proc DOFIELDVIEW()
private HOLDING
HOLDING = []
fieldview ; enter special mode
cursor normal ; turn on Canvas cursor
prompt "Editing Field: Enter saves/ends; Esc Cancels/Ends",""
while (true)
echo normal ; show workspace
echo off ; freeze Canvas
synccursor ; jump cursor to same position
retval = getchar() ; wait for a single key
switch
case ( retval <= -71 and retval >= -83 ) ; cursor keys
or ( retval >= 32 and retval <= 254 ) : ; alpha keys
keypress retval
case
retval = 8 : ; backspace
backspace
case
retval = 27 : ; esc
enter
[] = HOLDING ; undo capability
prompt ; restore prompt
cursor off ; turn canvas cursor off
return False
case
retval = 13 : ; enter
enter ; finish
prompt ; restore prompt
cursor off ; turn canvas cursor off
return True
otherwise : ; everything else
beep
endswitch
endwhile
endproc
edit "CUSTOMER"
pickform "1"
while (true)
wait table
prompt "You can make changes - press Esc to exit",
"Press AltF5 or CtrlF to enter FieldView"
until "Esc", "FieldView", "F35"
switch
case retval = "FieldView" or retval = "F35" :
DOFIELDVIEW() ; jump to new special proc
case retval = "Esc" :
Do_It! ; save
clearimage ; remove image
quit ; finish script
endswitch
endwhile Listing 4: Custom procedure for ZOOM
proc CUSTOM_ZOOM()
private VALUE
paintcanvas ; blank top two lines
fill " "
attribute syscolor(0)
0,0,1,79
@ 1,0 ?? "Type search value and press Enter; Esc cancels"
@ 0,0 ?? "Value: "
accept fieldtype() to VALUE ; wait for user entry
if retval = False then ; Esc was pressed
return
endif
zoom ; press Ctrl-Z
ctrlbackspace ; remove previous value
typein VALUE ; enter new value
enter ; press this key to search
endproc
edit "CUSTOMER"
pickform "1"
while (true)
wait table
prompt "You can make changes - press Esc to exit"
until "Esc", "Zoom"
switch
case retval = "Zoom" : ; user pressed this key
CUSTOM_ZOOM()
case retval = "Esc" :
Do_It!
clearimage
quit
endswitch
endwhile
Listing 5: A more complex Zoom
proc CUSTOM_ZOOM()
paintcanvas ; blank top two lines
fill " "
attribute syscolor(0)
0,0,1,79
@ 1,0 ?? "Type search value and press Enter; Esc cancels"
@ 0,0 ?? "Value: "
if field() = YYY ; test if on previous field
and isassigned(VALUE) ; and search was performed
and fieldtype() = type(VALUE) then ; and type is the same
accept fieldtype() default VALUE to VALUE
else
YYY = field() ; assign "flag"
accept fieldtype() to VALUE ; simple ACCEPT
endif
if retval = False then ; Esc was pressed
return
endif
zoom ; press Ctrl-Z
ctrlbackspace ; remove previous value
typein VALUE ; enter new value
enter ; press this key to search
if window() <> "" then ; message from Paradox
return window()
else
echo normal ; update Canvas
echo off
fieldview
home ; jump to start of field
synccursor ; update Canvas cursor
X = col() ; save position
enter
menu esc ; restore field position
synccursor ; update Canvas cursor
paintcanvas ; highlight field
reverse
row(), X, row(), col()
sleep 250 ; for 1/4 sec
return True
endif
endproc
proc EDIT_CUSTOMER()
private XXX, ; WAIT message
YYY, ; current field
VALUE ; search value
edit "CUSTOMER"
XXX = "" ; initialize message
YYY = field() ; and field
while (true)
wait table
prompt "You can make changes - press Esc to exit"
message XXX
until "Esc", "Zoom"
switch
case retval = "Zoom" : ; this key was pressed
CUSTOM_ZOOM() ; call proc
if retval = True then ; value found
XXX = "" ; message is null
else
XXX = retval ; message equals WINDOW()
endif
case retval = "Esc" :
Do_It!
clearimage
quit
endswitch
endwhile
endproc
EDIT_CUSTOMER()
Listing 6: Controling Table-lookup Valchecks
proc VALCHECKHELP()
help ; press F1
if helpmode() <> "LookupHelp" then ; check mode
esc
return False
endif
prompt "Select the value to insert and press F2",
"Or press Esc to cancel the operation"
cursor normal
while (true)
echo normal ; show Workspace
echo off ; freeze onto Canvas
synccursor
retval = getchar() ; get key from user
switch
case retval = -60 : ; F2
do_it!
quitloop
case retval = 27 : ; Esc
esc
quitloop
case retval = 26 : ; zoom
CUSTOM_ZOOM()
case retval = -44 : ; zoomnext
zoomnext
case retval <= -71
and retval >= -81 : ; major cursor keys
keypress retval
otherwise : ; everything else
beep
endswitch
endwhile
cursor off ; turn Canvas cursor off
prompt ; restore default prompt
return True ; lookup performed
endproc
edit "CUSTOMER"
pickform "1"
while (true)
wait table
prompt "You can make changes - press Esc to exit"
until "Esc", "F1"
switch
case retval = "F1" : ; this key was pressed
VALCHECKHELP() ; call custom proc
case retval = "Esc" :
Do_It!
clearimage
quit
endswitch
endwhile